VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "IFakeASM"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
'Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (ByRef Destination As Any, ByVal Length As Long)

Private m_sFileName As String
Private m_sCodeFileName As String

Private Type typeSub
 nStartIndex As Long
 nEndIndex As Long
 nReturnSub As Long
 nReturnIndex As Long
 nFlags As Long
End Type

Private Type typeInstruction
 nInst As Byte
 '0-nop
 '1-fd
 '2-lt
 '3-rt
 '4-jump
 '5-light
 nFlags As Byte
 '1=breakpoint
End Type

Private Type typeMap
 sName As String
 nWidth As Long
 nHeight As Long
 nStartX As Long
 nStartY As Long
 nStartFS As Long '0-l 1-u 2-r 3-d
 nMapData() As Long '1-based
 'bit 0-7 height
 '&H100 lightable
 nSubCount As Long
 nSubSize() As Long '0 to nSubCount
 nStackSize As Long 'currently unimplemented
 '///just instruction buffer only
 tInstBuffer() As typeInstruction
 '///
End Type

Private m_nCurLevel As Long
Private m_tMaps() As typeMap, m_nMapCount As Long

Private m_tSub() As typeSub '0 to m_nSubCount
Private m_nSubCount As Long
Private m_tInst() As typeInstruction
Private m_nInstCount As Long, m_nInstUsed As Long
Private m_nInstIndex As Long, m_nInstSub As Long

Private m_nCurMapData() As Byte
'1-light
Private m_nCurLightCount As Long
Private m_nCurX As Long
Private m_nCurY As Long
Private m_nCurFS As Long

Private m_nRunState As Long

Public Enum enumRunState
 RS_Stop = 0
 RS_Run = 1
 RS_RunStepInto = 2
 RS_RunStepOver = 3
 RS_RunStepOut = 4
 RS_Break = &H100&
End Enum

Private m_nRunToCursorIndex As Long
Private m_nRunSubCount As Long
Private m_bRunDirty As Boolean

Private m_obj As IFakeASM

'interface

Public Sub OnStep(ByVal nInstIndex As Long, ByVal nInstSub As Long, ByVal nLastIndex As Long, ByVal nLastSub As Long, ByVal nInst As Long, ByRef bBreak As Boolean, ByRef bTerminate As Boolean)

End Sub

Public Sub OnRun()

End Sub

Public Sub OnBreak()

End Sub

Public Sub OnTerminate()

End Sub

'functions

Friend Sub FlushInstructionBuffer()
If m_nCurLevel > 0 And m_nCurLevel <= m_nMapCount Then
 m_tMaps(m_nCurLevel).tInstBuffer = m_tInst
End If
End Sub

Friend Sub LoadInstructionBuffer()
'Dim m As Long
If m_nCurLevel > 0 And m_nCurLevel <= m_nMapCount And m_nInstCount > 0 Then
' m = UBound(m_tMaps(m_nCurLevel).tInstBuffer)
' If m < 0 Then m = 0 Else If m > m_nInstCount Then m = m_nInstCount
' If m > 0 Then _
' CopyMemory m_tInst(1), m_tMaps(m_nCurLevel).tInstBuffer(1), m * Len(m_tInst(1))
' If m < m_nInstCount Then _
' ZeroMemory m_tInst(m + 1), (m_nInstCount - m) * Len(m_tInst(1))
 m_tInst = m_tMaps(m_nCurLevel).tInstBuffer
 ReDim Preserve m_tInst(1 To m_nInstCount)
 CalculateInstructionUsed
 If m_nRunState Then m_bRunDirty = True
End If
End Sub

Friend Property Get RunDirty() As Boolean
RunDirty = m_bRunDirty
End Property

Friend Sub ResetCurrentLevelMap()
Dim i As Long, j As Long
Dim w As Long, h As Long
If m_nCurLevel > 0 And m_nCurLevel <= m_nMapCount Then
 w = m_tMaps(m_nCurLevel).nWidth
 h = m_tMaps(m_nCurLevel).nHeight
 m_nCurLightCount = 0
 m_nCurX = m_tMaps(m_nCurLevel).nStartX
 m_nCurY = m_tMaps(m_nCurLevel).nStartY
 m_nCurFS = m_tMaps(m_nCurLevel).nStartFS
 If w > 0 And h > 0 Then
  ReDim m_nCurMapData(1 To w, 1 To h)
  For j = 1 To h
   For i = 1 To w
    If m_tMaps(m_nCurLevel).nMapData(i, j) And &H100& Then m_nCurLightCount = m_nCurLightCount + 1
   Next i
  Next j
 Else
  Erase m_nCurMapData
 End If
End If
End Sub

Friend Property Get CallbackObject() As IFakeASM
Set CallbackObject = m_obj
End Property

Friend Property Set CallbackObject(ByVal obj As IFakeASM)
Set m_obj = obj
End Property

Friend Sub Run(ByVal nRunState As enumRunState)
If m_nRunState And &HFF& Then Exit Sub
If (nRunState And &HFF&) = 0 Then Exit Sub
'///
If m_nRunState = 0 Then 'init
 ResetCurrentLevelMap
 m_nInstIndex = 0
 m_nInstSub = 0
 m_bRunDirty = False
End If
'///
m_nRunState = nRunState
m_nRunSubCount = 0
If Not m_obj Is Nothing Then m_obj.OnRun
End Sub

Friend Sub OnTimer()
Dim i As Long, j As Long, k As Long
Dim jj As Long, kk As Long
Dim xx As Long, yy As Long
Dim b As Boolean, b2 As Boolean
Dim nInst As Long
i = m_nRunState
If (i And &HFF&) = 0 Then Exit Sub
'///record old instruction pointer
jj = m_nInstIndex
kk = m_nInstSub
'///run current statement
If m_nInstIndex > 0 And m_nInstIndex <= m_nInstCount Then nInst = m_tInst(m_nInstIndex).nInst
Select Case nInst
Case 0 'nop
Case 1, 4 'walk or jump
 If m_nCurFS And 1& Then 'up or down
  xx = m_nCurX
  If m_nCurFS And 2& Then 'down
   If m_nCurY < m_tMaps(m_nCurLevel).nHeight Then yy = m_nCurY + 1
  Else 'up
   If m_nCurY > 1 Then yy = m_nCurY - 1
  End If
 Else 'left or right
  yy = m_nCurY
  If m_nCurFS And 2& Then 'right
   If m_nCurX < m_tMaps(m_nCurLevel).nWidth Then xx = m_nCurX + 1
  Else 'left
   If m_nCurX > 1 Then xx = m_nCurX - 1
  End If
 End If
 If xx > 0 And yy > 0 Then
  j = m_tMaps(m_nCurLevel).nMapData(m_nCurX, m_nCurY) And &HFF&
  k = m_tMaps(m_nCurLevel).nMapData(xx, yy) And &HFF&
  If nInst = 1 Then b = j = k _
  Else b = j > k Or j + 1 = k
 End If
 If b Then
  m_nCurX = xx
  m_nCurY = yy
 Else
  nInst = nInst Or &H100&
 End If
 b = False
Case 2 'lt
 m_nCurFS = (m_nCurFS - 1) And 3&
Case 3 'rt
 m_nCurFS = (m_nCurFS + 1) And 3&
Case 5 'light
 If m_tMaps(m_nCurLevel).nMapData(m_nCurX, m_nCurY) And &H100& Then
  j = m_nCurMapData(m_nCurX, m_nCurY) Xor 1&
  m_nCurMapData(m_nCurX, m_nCurY) = j
  If j And 1& Then m_nCurLightCount = m_nCurLightCount - 1 _
  Else m_nCurLightCount = m_nCurLightCount + 1
 Else
  nInst = nInst Or &H100&
 End If
Case Else 'call
 nInst = nInst - 5
 If nInst > 0 And nInst <= m_nSubCount Then
  m_nInstSub = nInst
  m_nInstIndex = m_tSub(m_nInstSub).nStartIndex - 1
  m_tSub(m_nInstSub).nReturnIndex = jj + 1
  m_tSub(m_nInstSub).nReturnSub = kk
  m_nRunSubCount = m_nRunSubCount + 1
 End If
 nInst = 0
End Select
'///check exit sub?
m_nInstIndex = m_nInstIndex + 1
Do While m_nInstIndex > 0 And m_nInstIndex > m_tSub(m_nInstSub).nEndIndex '??? if infinite loop?
 j = m_tSub(m_nInstSub).nReturnIndex
 k = m_tSub(m_nInstSub).nReturnSub
 m_tSub(m_nInstSub).nReturnIndex = 0
 m_tSub(m_nInstSub).nReturnSub = 0
 If j > 0 And j <= m_nInstCount Then 'exit sub
  m_nInstIndex = j
  m_nInstSub = k
  m_nRunSubCount = m_nRunSubCount - 1
 Else 'end
  m_nInstIndex = 0
  m_nInstSub = 0
 End If
Loop
'///raise event
If Not m_obj Is Nothing Then m_obj.OnStep m_nInstIndex, m_nInstSub, jj, kk, nInst, b, b2
'///terminate?
If b2 Or m_nInstIndex = 0 Then
 m_nRunState = 0
 If Not m_obj Is Nothing Then m_obj.OnTerminate
 Exit Sub
End If
'///breakpoint?
Select Case i
Case 2 'step into
 b = True
Case 3 'step over
 b = b Or m_nRunSubCount <= 0
Case 4 'step out
 b = b Or m_nRunSubCount < 0
End Select
If m_tInst(m_nInstIndex).nFlags And 1& Then b = True
If m_nInstIndex = m_nRunToCursorIndex Then
 m_nRunToCursorIndex = 0
 b = True
End If
'///break?
If b Then
 m_nRunState = &H100&
 If Not m_obj Is Nothing Then m_obj.OnBreak
End If
End Sub

Friend Sub RunImmediate(ByVal s As String)
'TODO:
MsgBox "TODO:"
End Sub

Friend Property Get CurrentLevelSubCount() As Long
CurrentLevelSubCount = m_nSubCount
End Property

Friend Property Get CurrentLevelSubStartIndex(ByVal nIndex As Long) As Long
CurrentLevelSubStartIndex = m_tSub(nIndex).nStartIndex
End Property

Friend Property Get CurrentLevelSubEndIndex(ByVal nIndex As Long) As Long
CurrentLevelSubEndIndex = m_tSub(nIndex).nEndIndex
End Property

Friend Property Get CurrentLevelInstructionCount() As Long
CurrentLevelInstructionCount = m_nInstCount
End Property

Friend Property Get CurrentLevelInstructionUsed() As Long
CurrentLevelInstructionUsed = m_nInstUsed
End Property

Friend Property Get CurrentLevelInstruction(ByVal nIndex As Long) As Long
CurrentLevelInstruction = m_tInst(nIndex).nInst
End Property

Friend Property Let CurrentLevelInstruction(ByVal nIndex As Long, ByVal n As Long)
If m_tInst(nIndex).nInst Then m_nInstUsed = m_nInstUsed - 1
If n Then m_nInstUsed = m_nInstUsed + 1
m_tInst(nIndex).nInst = n
If m_nRunState Then m_bRunDirty = True
End Property

Friend Property Get CurrentLevelInstructionFlags(ByVal nIndex As Long) As Long
CurrentLevelInstructionFlags = m_tInst(nIndex).nFlags
End Property

Friend Property Let CurrentLevelInstructionFlags(ByVal nIndex As Long, ByVal n As Long)
m_tInst(nIndex).nFlags = n
End Property

Friend Property Get CurrentLevelInstructionIndex() As Long
CurrentLevelInstructionIndex = m_nInstIndex
End Property

Friend Property Get CurrentLevelInstructionSubIndex() As Long
CurrentLevelInstructionSubIndex = m_nInstSub
End Property

Friend Property Let CurrentLevelInstructionIndex(ByVal n As Long)
Dim i As Long, j As Long, k As Long
If m_nRunState = &H100& Then
 If m_nInstIndex <> n Then
  For i = 0 To m_nSubCount
   If n >= m_tSub(i).nStartIndex And n <= m_tSub(i).nEndIndex Then
    j = m_nInstIndex
    k = m_nInstSub
    m_nInstIndex = n
    m_nInstSub = i
    If Not m_obj Is Nothing Then m_obj.OnStep n, i, j, k, 0, False, False
    If m_nRunState Then m_bRunDirty = True
    Exit For
   End If
  Next i
 End If
End If
End Property

Friend Function InstructionToString(ByVal nIndex As Long, ByVal nInst As Long, ByVal nFlags As Long) As String
Dim s As String
'///
Select Case nInst
Case 0: s = "nop"
Case 1: s = "fd"
Case 2: s = "lt"
Case 3: s = "rt"
Case 4: s = "jump"
Case 5: s = "light"
Case Else: s = "call f" + CStr(nInst - 5)
End Select
'///
s = Format(nIndex, "000") + "     " + s
'///
If nFlags And 1& Then Mid(s, 5, 1) = "B"
'///
InstructionToString = s
End Function

Friend Function CurrentLevelInstructionToString(ByVal nIndex As Long) As String
Dim s As String
'///
s = InstructionToString(nIndex, m_tInst(nIndex).nInst, m_tInst(nIndex).nFlags)
'///
If nIndex = m_nInstIndex Then Mid(s, 7, 1) = ">"
'///
CurrentLevelInstructionToString = s
End Function

Friend Function LevelInstructionToString(ByVal nLevel As Long) As String
On Error Resume Next
Dim i As Long, j As Long, k As Long, m As Long
Dim ii As Long, jj As Long
Dim s As String
Err.Clear
m = UBound(m_tMaps(nLevel).tInstBuffer)
If Err.Number Then m = 0
k = 1
For i = 0 To m_tMaps(nLevel).nSubCount
 If i = 0 Then s = s + "; ----- main" + vbCrLf _
 Else s = s + "; ----- f" + CStr(i) + vbCrLf
 For j = 1 To m_tMaps(nLevel).nSubSize(i)
  If k > m Then
   ii = 0
   jj = 0
  Else
   ii = m_tMaps(nLevel).tInstBuffer(k).nInst
   jj = m_tMaps(nLevel).tInstBuffer(k).nFlags
  End If
  s = s + InstructionToString(k, ii, jj) + vbCrLf
  k = k + 1
 Next j
Next i
LevelInstructionToString = s
End Function

Friend Sub InstructionFromString(ByVal s As String, ByRef tInst() As typeInstruction, ByVal nStart As Long, ByVal bResize As Boolean)
On Error Resume Next
Dim m As Long, m2 As Long
Dim v As Variant
Dim i As Long, j As Long, k As Long
Dim lps As Long
Err.Clear
m = LBound(tInst)
m2 = UBound(tInst)
If m2 < m Or Err.Number <> 0 Then 'empty
 m = 1
 m2 = 0
End If
If nStart < m Then Exit Sub
If nStart > m2 And Not bResize Then Exit Sub
'///
v = Split(s, vbCrLf)
For i = 0 To UBound(v)
 s = LCase(Trim(v(i)))
 '///
 j = InStr(1, s, ";")
 If j > 0 Then s = Left(s, j - 1)
 j = InStr(1, s, "'")
 If j > 0 Then s = Left(s, j - 1)
 j = InStr(1, s, "/")
 If j > 0 Then s = Left(s, j - 1)
 j = InStr(1, s, "#")
 If j > 0 Then s = Left(s, j - 1)
 '///
 j = -1
 If InStr(1, s, "nop") Then
  j = 0
 ElseIf InStr(1, s, "fd") Then
  j = 1
 ElseIf InStr(1, s, "lt") Then
  j = 2
 ElseIf InStr(1, s, "rt") Then
  j = 3
 ElseIf InStr(1, s, "jump") Then
  j = 4
 ElseIf InStr(1, s, "light") Then
  j = 5
 Else
  lps = InStr(1, s, "call")
  If lps > 0 Then
   lps = lps + 4
   k = InStr(lps, s, "f")
   If k > 0 Then lps = k + 1
   k = 0
   k = Val(Mid(s, lps))
   If k > 0 And k <= m_nSubCount Then
    j = 5 + k
   End If
  End If
 End If
 '///
 If j >= 0 Then
  If nStart > m2 Then
   If bResize Then
    m2 = nStart
    ReDim Preserve tInst(m To m2)
   Else
    Exit For
   End If
  End If
  tInst(nStart).nInst = j
  '///
  j = InStr(1, s, "b") > 0 And 1&
  tInst(nStart).nFlags = j
  '///
  nStart = nStart + 1
  If nStart > m2 And Not bResize Then Exit For
 End If
Next i
End Sub

Friend Sub LevelInstructionFromString(ByVal nLevel As Long, ByVal s As String, ByVal nStart As Long)
Dim i As Long, m As Long
For i = 0 To m_tMaps(nLevel).nSubCount
 m = m + m_tMaps(nLevel).nSubSize(i)
Next i
If m > 0 Then
 ReDim m_tMaps(nLevel).tInstBuffer(1 To m)
 InstructionFromString s, m_tMaps(nLevel).tInstBuffer, nStart, False
Else
 Erase m_tMaps(nLevel).tInstBuffer
End If
End Sub

Friend Sub CurrentLevelInstructionFromString(ByVal s As String, ByVal nStart As Long)
If nStart <= 0 Or nStart > m_nInstCount Then Exit Sub
InstructionFromString s, m_tInst, nStart, False
CalculateInstructionUsed
If m_nRunState Then m_bRunDirty = True
End Sub
 
Friend Property Get RunState() As enumRunState
RunState = m_nRunState
End Property

Friend Property Get RunToCursorIndex() As Long
RunToCursorIndex = m_nRunToCursorIndex
End Property

Friend Property Let RunToCursorIndex(ByVal n As Long)
m_nRunToCursorIndex = n
End Property

Friend Property Get CurrentLevel() As Long
CurrentLevel = m_nCurLevel
End Property

Friend Property Get CurrentLevelX() As Long
CurrentLevelX = m_nCurX
End Property

Friend Property Get CurrentLevelY() As Long
CurrentLevelY = m_nCurY
End Property

Friend Property Get CurrentLevelFS() As Long
CurrentLevelFS = m_nCurFS
End Property

Friend Property Let CurrentLevelX(ByVal n As Long)
m_nCurX = n
If m_nRunState Then m_bRunDirty = True
End Property

Friend Property Let CurrentLevelY(ByVal n As Long)
m_nCurY = n
If m_nRunState Then m_bRunDirty = True
End Property

Friend Property Let CurrentLevelFS(ByVal n As Long)
m_nCurFS = n
If m_nRunState Then m_bRunDirty = True
End Property

Friend Property Get CurrentLevelData(ByVal x As Long, ByVal y As Long) As Long
CurrentLevelData = m_nCurMapData(x, y)
End Property

Friend Property Get CurrentLevelLightRemaining() As Long
CurrentLevelLightRemaining = m_nCurLightCount
End Property

Friend Sub SetCurrentLevel(ByVal nIndex As Long)
Dim i As Long, m As Long
'///
Terminate
'///
If nIndex > 0 And nIndex <= m_nMapCount Then
 '///instruction buffer operation
 If m_nCurLevel > 0 And m_nCurLevel <= m_nMapCount And m_nCurLevel <> nIndex Then
  m_tMaps(m_nCurLevel).tInstBuffer = m_tInst
  m_tInst = m_tMaps(nIndex).tInstBuffer
 End If
 '///
 m_nCurLevel = nIndex
 m_nSubCount = m_tMaps(nIndex).nSubCount
 ReDim m_tSub(m_nSubCount)
 For i = 0 To m_nSubCount
  m_tSub(i).nStartIndex = m + 1
  m = m + m_tMaps(nIndex).nSubSize(i)
  m_tSub(i).nEndIndex = m
 Next i
 m_nInstCount = m
 If m > 0 Then ReDim Preserve m_tInst(1 To m) Else Erase m_tInst
 m_nInstIndex = 0
 m_nInstSub = 0
 '///
 CalculateInstructionUsed
 ResetCurrentLevelMap
End If
End Sub

Friend Function InsertLevel(Optional ByVal nLevel As Long) As Long
Dim t As typeMap
Dim i As Long
'///
Terminate
'///
t.nWidth = 8
t.nHeight = 8
t.nStartX = 4
t.nStartY = 4
t.nStartFS = 2
t.nSubCount = 2
ReDim t.nMapData(1 To 8, 1 To 8), t.nSubSize(2)
t.nSubSize(0) = 12
t.nSubSize(1) = 8
t.nSubSize(2) = 8
'///
m_nMapCount = m_nMapCount + 1
ReDim Preserve m_tMaps(1 To m_nMapCount)
If nLevel > 0 And nLevel < m_nMapCount Then
 For i = m_nMapCount To nLevel + 1 Step -1
  m_tMaps(i) = m_tMaps(i - 1)
 Next i
 m_tMaps(nLevel) = t
 InsertLevel = nLevel
Else
 m_tMaps(m_nMapCount) = t
 InsertLevel = m_nMapCount
End If
End Function

Friend Property Get LevelName(ByVal nLevel As Long) As String
LevelName = m_tMaps(nLevel).sName
End Property

Friend Property Let LevelName(ByVal nLevel As Long, ByRef s As String)
m_tMaps(nLevel).sName = s
End Property

Friend Property Get LevelWidth(ByVal nLevel As Long) As Long
LevelWidth = m_tMaps(nLevel).nWidth
End Property

Friend Property Get LevelHeight(ByVal nLevel As Long) As Long
LevelHeight = m_tMaps(nLevel).nHeight
End Property

Friend Sub EraseMapData(ByVal nLevel As Long, Optional ByVal nWidth As Long, Optional ByVal nHeight As Long)
Terminate
If nWidth <= 0 Or nHeight <= 0 Then
 nWidth = m_tMaps(nLevel).nWidth
 nHeight = m_tMaps(nLevel).nHeight
End If
If nWidth > 0 And nHeight > 0 Then ReDim m_tMaps(nLevel).nMapData(nWidth, nHeight) _
Else Erase m_tMaps(nLevel).nMapData
m_tMaps(nLevel).nWidth = nWidth
m_tMaps(nLevel).nHeight = nHeight
End Sub

Friend Property Get LevelData(ByVal nLevel As Long, ByVal x As Long, ByVal y As Long) As Long
LevelData = m_tMaps(nLevel).nMapData(x, y)
End Property

Friend Property Let LevelData(ByVal nLevel As Long, ByVal x As Long, ByVal y As Long, ByVal n As Long)
m_tMaps(nLevel).nMapData(x, y) = n
End Property

Friend Property Get LevelStartX(ByVal nLevel As Long) As Long
LevelStartX = m_tMaps(nLevel).nStartX
End Property

Friend Property Get LevelStartY(ByVal nLevel As Long) As Long
LevelStartY = m_tMaps(nLevel).nStartY
End Property

Friend Property Get LevelStartFS(ByVal nLevel As Long) As Long
LevelStartFS = m_tMaps(nLevel).nStartFS
End Property

Friend Property Let LevelStartX(ByVal nLevel As Long, ByVal n As Long)
m_tMaps(nLevel).nStartX = n
End Property

Friend Property Let LevelStartY(ByVal nLevel As Long, ByVal n As Long)
m_tMaps(nLevel).nStartY = n
End Property

Friend Property Let LevelStartFS(ByVal nLevel As Long, ByVal n As Long)
m_tMaps(nLevel).nStartFS = n
End Property

Friend Property Get LevelStackSize(ByVal nLevel As Long) As Long
LevelStackSize = m_tMaps(nLevel).nStackSize
End Property

Friend Property Get LevelSubCount(ByVal nLevel As Long) As Long
LevelSubCount = m_tMaps(nLevel).nSubCount
End Property

Friend Property Let LevelStackSize(ByVal nLevel As Long, ByVal n As Long)
m_tMaps(nLevel).nStackSize = n
End Property

Friend Property Let LevelSubCount(ByVal nLevel As Long, ByVal n As Long)
If m_tMaps(nLevel).nSubCount <> n Then
 m_tMaps(nLevel).nSubCount = n
 ReDim Preserve m_tMaps(nLevel).nSubSize(n)
End If
End Property

Friend Property Get LevelSubSize(ByVal nLevel As Long, ByVal nSubIndex As Long) As Long
LevelSubSize = m_tMaps(nLevel).nSubSize(nSubIndex)
End Property

Friend Property Let LevelSubSize(ByVal nLevel As Long, ByVal nSubIndex As Long, ByVal n As Long)
m_tMaps(nLevel).nSubSize(nSubIndex) = n
End Property

Friend Function SaveMap(Optional ByVal sFileName As String, Optional ByVal nStart As Long, Optional ByVal nCount As Long) As Boolean
On Error GoTo a
Dim idx As Long, i As Long, j As Long
Dim b As Boolean
If sFileName = "" Then sFileName = m_sFileName
If sFileName = "" Then Exit Function
If nStart > 0 And nStart <= m_nMapCount Then
 nCount = nStart + nCount - 1
 If nCount > m_nMapCount Or nCount < nStart Then nCount = m_nMapCount
Else
 nStart = 1
 nCount = m_nMapCount
 b = True
End If
Open sFileName For Output As #1
For idx = nStart To nCount
 Print #1, "Level:" + m_tMaps(idx).sName
 Print #1, CStr(m_tMaps(idx).nWidth) + "," + CStr(m_tMaps(idx).nHeight) + "," + _
 CStr(m_tMaps(idx).nStartX) + "," + CStr(m_tMaps(idx).nStartY) + "," + CStr(m_tMaps(idx).nStartFS)
 For j = 1 To m_tMaps(idx).nHeight
  For i = 1 To m_tMaps(idx).nWidth
   Print #1, CStr(m_tMaps(idx).nMapData(i, j)) + ",";
  Next i
  Print #1,
 Next j
 Print #1, CStr(m_tMaps(idx).nSubCount) + "," + CStr(m_tMaps(idx).nStackSize)
 For i = 0 To m_tMaps(idx).nSubCount
  Print #1, CStr(m_tMaps(idx).nSubSize(i)) + ",";
 Next i
 Print #1,
Next idx
SaveMap = True
If b Then m_sFileName = sFileName
a:
Close
End Function

Friend Function LoadMap(ByVal sFileName As String, Optional ByVal nStart As Long, Optional ByVal nCount As Long) As Boolean
On Error GoTo a
Dim idx As Long, i As Long, j As Long
Dim s As String
Dim v As Variant
Dim b As Boolean
'///
Terminate
'///
If nStart = 0 Then
 Erase m_tMaps
 m_nMapCount = 0
 nStart = 1
 nCount = &H7FFFFFFF
 b = True
Else
 If nStart < 0 Or nStart > m_nMapCount Then nStart = m_nMapCount + 1
 nCount = nStart + nCount - 1
 If nCount < nStart Then nCount = &H7FFFFFFF
End If
Open sFileName For Input As #1
For idx = nStart To nCount
 i = 1
 Do Until EOF(1)
  Line Input #1, s
  s = Trim(s)
  i = StrComp(Left(s, 6), "Level:", vbTextCompare)
  If i = 0 Then Exit Do
 Loop
 If i Then Exit For
 '///
 If idx > m_nMapCount Then
  m_nMapCount = idx
  ReDim Preserve m_tMaps(1 To m_nMapCount)
 End If
 m_tMaps(idx).sName = Mid(s, 7)
 Line Input #1, s
 v = Split(s, ",")
 m_tMaps(idx).nWidth = Val(v(0))
 m_tMaps(idx).nHeight = Val(v(1))
 m_tMaps(idx).nStartX = Val(v(2))
 m_tMaps(idx).nStartY = Val(v(3))
 m_tMaps(idx).nStartFS = Val(v(4))
 ReDim m_tMaps(idx).nMapData(1 To m_tMaps(idx).nWidth, 1 To m_tMaps(idx).nHeight)
 For j = 1 To m_tMaps(idx).nHeight
  Line Input #1, s
  v = Split(s, ",")
  For i = 1 To m_tMaps(idx).nWidth
   m_tMaps(idx).nMapData(i, j) = Val(v(i - 1))
  Next i
 Next j
 '///
 Line Input #1, s
 v = Split(s, ",")
 m_tMaps(idx).nSubCount = Val(v(0))
 m_tMaps(idx).nStackSize = Val(v(1))
 ReDim m_tMaps(idx).nSubSize(m_tMaps(idx).nSubCount)
 Line Input #1, s
 v = Split(s, ",")
 For i = 0 To m_tMaps(idx).nSubCount
  m_tMaps(idx).nSubSize(i) = Val(v(i))
 Next i
 '///
Next idx
'///
LoadMap = True
If b Then m_sFileName = sFileName
a:
Close
End Function

Friend Function LoadCode(ByVal sFileName As String, Optional ByVal nStart As Long, Optional ByVal nCount As Long) As Boolean
On Error GoTo a
Dim idx As Long, i As Long
Dim s As String, s1 As String
Dim b As Boolean
'///
Terminate
'///
If nStart > 0 And nStart <= m_nMapCount Then
 nCount = nStart + nCount - 1
 If nCount > m_nMapCount Or nCount < nStart Then nCount = m_nMapCount
Else
 nStart = 1
 nCount = m_nMapCount
 b = True
End If
Open sFileName For Input As #1
For idx = nStart To nCount
 i = 1
 s1 = ""
 Do Until EOF(1)
  Line Input #1, s
  s = Trim(s)
  '///
  If s <> "" Then
   i = StrComp(Left(s, 5), "Level", vbTextCompare)
   If i = 0 Then
    If s1 <> "" Then Exit Do
   Else
    s1 = s1 + s + vbCrLf
   End If
  End If
 Loop
 '///
 LevelInstructionFromString idx, s1, 1
 '///
 If i Then Exit For
Next idx
'///
LoadCode = True
If b Then m_sCodeFileName = sFileName
a:
Close
End Function

Friend Function SaveCode(Optional ByVal sFileName As String, Optional ByVal nStart As Long, Optional ByVal nCount As Long) As Boolean
'On Error GoTo a
Dim idx As Long, s As String
Dim b As Boolean
If sFileName = "" Then sFileName = m_sCodeFileName
If sFileName = "" Then Exit Function
If nStart > 0 And nStart <= m_nMapCount Then
 nCount = nStart + nCount - 1
 If nCount > m_nMapCount Or nCount < nStart Then nCount = m_nMapCount
Else
 nStart = 1
 nCount = m_nMapCount
 b = True
End If
Open sFileName For Output As #1
For idx = nStart To nCount
 Print #1, "Level " + CStr(idx) + ":"
 s = LevelInstructionToString(idx)
 Print #1, s
Next idx
SaveCode = True
If b Then m_sCodeFileName = sFileName
a:
Close
End Function

Friend Sub CalculateInstructionUsed()
Dim i As Long
m_nInstUsed = 0
For i = 1 To m_nInstCount
 If m_tInst(i).nInst Then _
 m_nInstUsed = m_nInstUsed + 1
Next i
End Sub

Friend Sub Break()
If m_nRunState And &HFF& Then
 m_nRunState = &H100&
 If Not m_obj Is Nothing Then m_obj.OnBreak
End If
End Sub

Friend Sub Terminate()
Dim i As Long, j As Long
If m_nRunState Then
 m_nRunState = 0
 i = m_nInstIndex
 j = m_nInstSub
 m_nInstIndex = 0
 m_nInstSub = 0
 m_bRunDirty = True
 If Not m_obj Is Nothing Then
  m_obj.OnStep 0, 0, i, j, 0, False, False
  m_obj.OnTerminate
 End If
End If
End Sub

Friend Sub Destroy()
Dim t As typeMap
'///
Terminate
'///
Erase m_tMaps, m_tSub, m_tInst
m_nMapCount = 0
m_nCurLevel = 0
m_nSubCount = 0
m_nInstCount = 0
m_nInstUsed = 0
m_nInstIndex = 0
m_nInstSub = 0
m_nRunState = 0
m_sFileName = ""
m_sCodeFileName = ""
End Sub

Friend Property Get LevelCount() As Long
LevelCount = m_nMapCount
End Property

Friend Property Get FileName() As String
FileName = m_sFileName
End Property

Friend Property Get CodeFileName() As String
CodeFileName = m_sCodeFileName
End Property

Private Sub Class_Terminate()
Terminate
End Sub
